home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The X-Philes (2nd Revision)
/
The X-Philes Number 1 (1995).iso
/
xphiles
/
hp48hor1
/
astronut.src
< prev
next >
Wrap
Text File
|
1991-05-29
|
6KB
|
227 lines
%%HP: T(3)A(R)F(.);
@ ASTRONUT, by Kevin Jessup
@
DIR @ AstroNUT directory
PLAY @ push PLAY to start
\<< RCLF 3 FIX @ save flags
-19 CF # 83h # 40h @ create a blank PICT
BLANK PICT STO 1 CF @ clear the crash flag
170 'ht' STO @ set height to 170 feet
-20 'v' STO 5 @ set vertical v to -20
IF RAND .5 < @ set horiz v to 5 or -5
THEN NEG
END 'hv' STO
RAND 80 * IP 'x' @ random horiz position
STO 100 'fuel' STO @ 100 unit of fuel
2 CF @ clear the bottom flag
MAKBOTTOM { # 0h @ random terrain coordinates
# 0h } PVIEW MAIN @ display and loop on main
CRASHht 'ht' STO @ display landing parameters
CRASHx 'x' STO
CRASHv 'v' STO
STATUS PICT NEWC @ display landing position
SHIP GXOR PICT { @ display AstroNUT or CRASH
# 5h # 5h }
IF CRASHv -4 @ test slope, vv and hv
< CRASHsl ABS .084
> OR hv OR
THEN
"*CRASH*" LOOSE
ELSE PICT 7
'ht' STO+ 1 'x'
STO+ NEWC aflag REPL
"AstroNUT" WIN
END 3 \->GROB
REPL 7 FREEZE @ freeze the display
globals PURGE @ purge temporary globals
WHILE KEY @ flush any excess keys
REPEAT DROP
END STOF @ restore flags and quit
\>>
WIN @ Play the WIN tune.
\<< 125 @ "I am not a musician!"
DO DUP .02
BEEP 2 *
UNTIL DUP
4000 >
END DROP
\>>
LOOSE @ Play the LOOSE tune
\<< 4000
DO DUP .02
BEEP 2 /
UNTIL DUP 125
<
END DROP
\>>
MAIN @ main processing loop
\<<
DO @ draw or erase the terraine
IF ht 56 >
THEN
IF 2 FS?
THEN
ERASE 2 CF
END
ELSE
IF 2 FC?
THEN
DRAWBOTTOM 2 SF
END
END STATUS @ display flight parameters
NEWC PICT OVER SHIP @ display the lander
GXOR ht 20 * .01 @ beep based on altitude
BEEP v 'ht' STO+ hv @ calculate new position
'x' STO+
IF x 124 > @ wrap horizontal
x 0 < OR
THEN x 125
MOD ABS 'x' STO
END
CHKBOTTOM GETKEY ag @ see if we crashed, process keys
'v' STO+ PICT SWAP @ acceleration increases v
SHIP GXOR @ erase old position
UNTIL 1 FS? @ quit if we landed or crashed
END
\>>
@ CHKBOTTOM is the routine that eats all the CPU time.
@ If anyone knows how to speed it up, please do so.
@ It works by calculating linear regressions and then
@ comparing the line slopes.
CHKBOTTOM @ set flag 1 if we crashed
\<< 1 botCOORDS @ get terraine coordinates list size
SIZE 1 -
FOR i @ test each line segment
botCOORDS i GETI 3 @ get line endpoints
ROLLD GET DUP2 1 @ duplicate them
GET SWAP 1 GET @ get the x coordinates and
IF x 3 + \<= @ see if lander is between them
SWAP x 3 + > AND
THEN OVER @ if so, compare line slopes
C\->V2 CL\GS \GS+ C\->V2 \GS+ @ calculate line slope
LR x DUP 'CRASHx' @ calculate and save possible
STO 3 + PREDY @ crash x and y positions
'CRASHht' STO SWAP
DROP DUP 'CRASHsl' @ save crash slope
STO SWAP C\->V2 CL\GS @ calculate slope of line to
\GS+ x 3.001 + ht \->V2 @ the landers coordinates
\GS+ LR SWAP DROP
IF \>= @ if line segment slope >= the
THEN 1 SF @ slope of line to lander,
v @ we crahed. Set crash flag.
'CRASHv' STO 99 'i' @ save crash velocity
STO
END
ELSE DROP2 @ not within this line segment
END
NEXT @ check next line
\>>
MAKBOTTOM @ generates a list of coordinates
\<< { } 0 120 @ get an empty list
FOR a a RAND @ generate a random y coordinate
25 * IP 6 + 2 \->LIST
1 \->LIST + 12 @ save xy in list, do next
STEP 130 OVER @ line up the end points so
1 GET OBJ\-> DROP @ we don't impact on wrap
SWAP DROP 2 \->LIST 1
\->LIST + 9 RAND * IP @ insure at least one flat line
2 + GETI 2 GET 3
ROLLD GETI 2 5 ROLL
PUT SWAP 1 - SWAP
PUT 'botCOORDS' STO @ save the list
\>>
DRAWBOTTOM @ maps terraine coordinates to
\<< 1 botCOORDS @ screen and display the lines
SIZE 1 -
FOR i
botCOORDS i GETI
OBJ\-> ROT R\->B ROT 63
SWAP - R\->B ROT
\->LIST 3 ROLLD GET
OBJ\-> ROT R\->B ROT 63
SWAP - R\->B ROT
\->LIST LINE
NEXT
\>>
STATUS @ displays the flight parameters
\<<
\<< + 1 \->GROB
PICT 3 ROLLD REPL
\>> \-> s
\<< { # 54h
# 0h } "Height: "
ht s EVAL { # 54h
# 6h } "VertV: " v
s EVAL { # 54h # Ch
} "HorizV: " hv s
EVAL { # 54h # 12h
} "Fuel: " fuel s
EVAL
\>>
\>>
GETKEY @ processes keys
\<<
WHILE KEY
REPEAT
IF fuel 0 > @ but only if we got fuel!
THEN
CASE DUP
72 ==
THEN -1
'hv' STO+ -1 'fuel'
STO+
END DUP
74 ==
THEN 1
'hv' STO+ -1 'fuel'
STO+
END DUP
63 ==
THEN
thrust DUP NEG
'fuel' STO+ 'v'
STO+
END
END
END DROP
END
\>>
NEWC @ get current screen coordiantes
\<< x R\->B 57 1 ht
57 MOD 57 / - * R\->B
2 \->LIST
\>>
C\->V2 @ convert 2-element list to vector
\<< OBJ\-> DROP \->V2
\>>
SHIP @ GROB of the lander
GROB 6 6 E13333E11212
aflag @ GROB of a flag
GROB 7 7 F7747414F71010
thrust 2 @ vertical thrust = -1/2 ag
ag -4 @ acceleration due to gravity
globals { \GSDAT @ these are PURGEd
CRASHv CRASHsl
CRASHht CRASHx \GSPAR
botCOORDS fuel x hv
v ht }
END